home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue40 / Construc / TRKTABLE.DPR < prev    next >
Encoding:
Text File  |  1998-10-31  |  4.6 KB  |  150 lines
  1. program TrkTable;
  2. {$APPTYPE CONSOLE}
  3. uses
  4.   SysUtils, DB, DBTables;
  5. var
  6.   f: Text;
  7.   i: Integer;
  8.   Str,Agent: String;
  9.   hits: Integer = 0;
  10.   refer: Integer = 0;
  11.  
  12.   function CopyStripDelete(var Str: String; From,Len: Integer): String;
  13.   begin
  14.     Result := Copy(Str,From,Len); { copy }
  15.     Delete(Str,1,Len); { delete }
  16.     Len := Length(Result);
  17.     while Result[Len] = #32 do Dec(Len);
  18.     SetLength(Result,Len) { strip }
  19.   end {CopyStripDelete};
  20.  
  21. begin
  22.   if ParamCount = 0 then
  23.   begin
  24.     writeln('Usage: TrkTable [datfile]');
  25.     Halt
  26.   end;
  27.  
  28.   with TTable.Create(nil) do
  29.   try
  30.     Active := False;
  31.     TableType := ttParadox;
  32.     TableName := ParamStr(1)+'.DB';
  33.     with FieldDefs do
  34.     begin
  35.       Clear;
  36.       Add('DateTime', ftString, 24, FALSE);
  37.       Add('Hours', ftInteger, 0, FALSE);
  38.       Add('IP', ftString, 16, FALSE);
  39.       Add('Browser', ftString, 32, FALSE);
  40.       Add('OSystem', ftString, 32, FALSE);
  41.       Add('ThisPage', ftString, 128, FALSE);
  42.       Add('Referrer', ftString, 128, FALSE);
  43.     end;
  44.     CreateTable;
  45.     Open;
  46.     System.Assign(f,ParamStr(1)+'.trk');
  47.     System.Reset(f);
  48.     while not System.Eof(f) do
  49.     begin
  50.       readln(f,Str);
  51.       Append;
  52.       Agent := CopyStripDelete(Str,1,24);
  53.       FieldByName('DateTime').AsString := Agent;
  54.       System.Delete(Agent,1,11);
  55.       if Pos('AM',Agent) > 0 then
  56.       begin
  57.         System.Delete(Agent,Pos(':',Agent),255);
  58.         if Agent = '12' then
  59.           FieldByName('Hours').AsInteger := 0
  60.         else FieldByName('Hours').AsInteger := StrToInt(Agent)
  61.       end
  62.       else { PM }
  63.       begin
  64.         System.Delete(Agent,Pos(':',Agent),255);
  65.         FieldByName('Hours').AsInteger := StrToInt(Agent) + 12
  66.       end;
  67.       FieldByName('IP').AsString :=
  68.         CopyStripDelete(Str,1,16);
  69.       Agent := CopyStripDelete(Str,1,128);
  70.       if (Pos('Windows NT', Agent) > 0) or (Pos('WinNT', Agent) > 0) then { WinNT }
  71.         FieldByName('OSystem').AsString := 'WinNT'
  72.       else
  73.         if (Pos('Windows 95', Agent) > 0) or (Pos('Win95', Agent) > 0) then { Windows 95 }
  74.           FieldByName('OSystem').AsString := 'Win95'
  75.         else
  76.           if (Pos('Windows 98', Agent) > 0) or (Pos('Win98', Agent) > 0) then { Windows 98 }
  77.             FieldByName('OSystem').AsString := 'Win98'
  78.           else
  79.             if Pos('Win16', Agent) > 0 then
  80.               FieldByName('OSystem').AsString := 'Win16'
  81.             else
  82.               if Pos('Linux', Agent) > 0 then
  83.                 FieldByName('OSystem').AsString := 'Linux'
  84.               else
  85.                 if Pos('Teleport', Agent) > 0 then
  86.                   FieldByName('OSystem').AsString := 'Teleport'
  87.                 else
  88.                   FieldByName('OSystem').AsString := 'other';
  89.       if Pos('(compatible; ',Agent) > 0 then
  90.       begin
  91.         System.Delete(Agent,1,pos('(compatible; ',Agent)+12);
  92.         if Pos('MSIE',Agent) > 0 then
  93.           System.Delete(Agent,1,Pos('MSIE',Agent)-1);
  94.         if Pos(';',Agent) > 0 then
  95.           System.Delete(Agent,Pos(';',Agent),255)
  96.         else
  97.           if Pos(')',Agent) > 0 then
  98.             System.Delete(Agent,Pos(')',Agent),255)
  99.       end
  100.       else
  101.       if Pos('MSIE',Agent) > 0 then
  102.         System.Delete(Agent,1,Pos('MSIE',Agent)-1)
  103.       else
  104.         if Pos(' ',Agent) > 0 then
  105.           System.Delete(Agent,Pos(' ',Agent),255);
  106.       if Pos('Mozilla/',Agent) = 1 then
  107.       begin
  108.         System.Delete(Agent,1,8);
  109.         Agent := 'Netscape ' + Agent
  110.       end
  111.       else
  112.         if (Length(Agent) < 2) or
  113.            (Agent[1] = '(') then Agent := 'other';
  114.       i := Pos(' ',Agent);
  115.       if i > 0 then
  116.       begin
  117.         repeat
  118.           Inc(i)
  119.         until not (Agent[i] in ['0'..'9','.']);
  120.         System.Delete(Agent,i,255);
  121.         i := Pos('.0',Agent);
  122.         if (i > 0) and (Length(Agent) > i+1) then
  123.         begin
  124.           System.Delete(Agent,i+3,255);
  125.           Agent[i+2] := 'x' { 4.0x }
  126.         end
  127.       end;
  128.       if (FieldByName('OSystem').AsString = 'other') and
  129.          (Pos('MSIE',Agent) > 0) then
  130.         FieldByName('OSystem').AsString := 'Win16';
  131.       FieldByName('Browser').AsString := Agent;
  132.       FieldByName('ThisPage').AsString :=
  133.         CopyStripDelete(Str,1,128);
  134.       FieldByName('Referrer').AsString :=
  135.         CopyStripDelete(Str,1,128);
  136.       if FieldByName('Referrer').AsString <> '@' then
  137.         Inc(refer); // actual referrer info
  138.       Post;
  139.       Inc(hits)
  140.     end;
  141.     writeln(hits,' page requests (',
  142.            (refer*100) div hits,'% referred) ',
  143.            'in logfile ',ParamStr(1))
  144.   finally
  145.     System.Close(f);
  146.     Close;
  147.     Free
  148.   end
  149. end.
  150.